home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / emacs / lisp / wais.el
Encoding:
Text File  |  1995-07-26  |  73.5 KB  |  2,408 lines
  1. ;;; A GNU Emacs interface to WAIS
  2. ;;;
  3. ;;;  Jonny Goldman <jonathan@think.com>
  4. ;;;
  5. ;;; liberally ripped off from various sources, and heavily influenced
  6. ;;; by wais-interface.el from Brewster and Bonnie.
  7. ;;;
  8. ;;; $Header: /usr/local/ls6/src+data/src/freeWAIS-sf/ui/RCS/wais.el.raw,v 1.1 1994/08/05 07:19:54 pfeifer Exp $
  9. ;;; include the following in your .emacs file (without semicolons):
  10. ;;; (autoload 'wais "wais"
  11. ;;;       "Do something useful for WAIS" t)
  12. ;;; (autoload 'wais-select-question "wais"
  13. ;;;       "Select a question for WAIS" t)
  14. ;;; (autoload 'wais-create-question "wais"
  15. ;;;       "Create a new question for WAIS" t)
  16.  
  17. (provide 'wais)
  18. (require 'cl)
  19.  
  20. ;;; These are important variables.  Set them appropriately.
  21.  
  22. (defvar *wais-top-directory* /usr/skunk)
  23. (defvar waisq-program (concat *wais-top-directory* "bin/waisq")
  24.   "Location of the waisq executable. 
  25.    This comes in the bin directory of the wais release") 
  26. (defvar waisindex-program (concat *wais-top-directory* "bin/waisindex")
  27.   "Location of the waisindex executable. 
  28.    This comes in the bin directory of the wais release")
  29. (defvar *common-source-directory* (concat *wais-top-directory* "wais-sources/")
  30.   "Where the common sources for you site live.  nil if there are none")
  31.  
  32. (defvar *wais-maximum-result-documents* 40
  33.   "Maximum number of results to return for a question.  If you change this,
  34. be sure to kill the wais-receiving buffer.")
  35.  
  36. (defvar *wais-question-directory*
  37.     "~/wais-questions/"
  38.   "User's question directory")
  39. (defvar *wais-source-directory*
  40.     "~/wais-sources/"
  41.   "User's source directory")
  42. (defvar *wais-document-directory*
  43.     "~/wais-documents/"
  44.   "User's document directory")
  45.  
  46. (defvar wais-version 8)
  47.  
  48. (defvar *debug* nil)
  49.  
  50. (defvar *waisq-truncate-mode* t
  51.  "switch to set truncate mode in waisq buffers.  Set to nil for line wrap")
  52.  
  53. (defvar *wais-document-display-size* 4
  54.   "Number of lines of document headers to display when text is shown")
  55.  
  56. (defvar *wais-multiple-document-buffers* t
  57.   "If set to nil, use one buffer for all retrieved documents.
  58. A retrieval request will be issued each time a document is
  59. selected for editing.
  60. Otherwise, use Multiple buffers for retrieving Documents.
  61. Retrieval requests are made only once, and the buffer is reused.")
  62.  
  63. (defvar *wais-document-buffer* "Wais DOC"
  64.   "Name of buffer when *wais-multiple-document-buffers* is nil")
  65.  
  66. (defvar *x-viewers* 
  67.   (list (list "GIF" (concat *wais-top-directory* "bin/wais-gif-display"))
  68.     (list "TIFF" (concat *wais-top-directory* "bin/wais-tiff-display"))
  69.     (list "PICT" (concat *wais-top-directory* "bin/wais-pict-display")))
  70.   "Alist of Programs to use to view under X
  71. format: ((type viewer) (type viewer) ...)")
  72.  
  73. (defvar *wais-show-size* t
  74.   "Show size of document in results window")
  75.  
  76. (defvar *wais-show-date* t
  77.   "Show date of document in results window")
  78.  
  79. (defun current-line ()
  80.   "return the current line number (in the buffer) of point."
  81.   (save-restriction
  82.     (widen)
  83.     (save-excursion
  84.       (beginning-of-line)
  85.       (1+ (count-lines 1 (point))))))
  86.  
  87. (defconst *wais-client-machine* nil
  88.   "if set, this machine will be used to run *wais-binary-pathname* 
  89.    (using rsh)")
  90.  
  91. (defvar *wais-process* () "the variable that holds the wais process struct")
  92. (defvar *wais-receiving-buffer* "wais-receiving-buffer")
  93.  
  94. (defun shell-command-fast (string)
  95.   (let ((buf (get-buffer-create "*Shell Command Output*"))
  96.     )
  97.     (save-excursion
  98.       (set-buffer buf)
  99.       (erase-buffer))
  100.     (call-process shell-file-name nil buf nil "-f" "-c" string)
  101.     ))
  102.  
  103. (defun wais-toggle-multiple-buffers ()
  104.   "Switch between multiple WAIS DOC buffers and one WAIS DOC buffer"
  105.   (interactive)
  106.   (setq *wais-multiple-document-buffers*
  107.     (not *wais-multiple-document-buffers*))
  108.   (message (if *wais-multiple-document-buffers*
  109.            "Using multiple Document buffers"
  110.            "Using single Document buffer")))
  111.  
  112. (defun wais-find-process ()
  113.   "Check status of 'wais' process and start if necessary."
  114.   (unless (and *wais-process*
  115.            (eq (process-status *wais-process*) 'run))
  116.     (message "Starting new wais process...")
  117.     (and (get-buffer *wais-receiving-buffer*) 
  118.      (kill-buffer *wais-receiving-buffer*))
  119.     ;; bind process-connection-type to nil
  120.     ;; to avoid allocating a pty. -- taylor, 21 Oct 88
  121.     (let (
  122.       ;; this doesn't work on the NeXT.  Comment out this line.
  123.       (process-connection-type nil)
  124.       )
  125.       (if *wais-client-machine*
  126.       (setq *wais-process* 
  127.         (start-process "WAIS" *wais-receiving-buffer* 
  128.                    "rsh" *wais-client-machine*
  129.                    waisq-program "-"
  130.                    "-m"
  131.                    (format "%d" *wais-maximum-result-documents*)
  132.                    (if *common-source-directory*
  133.                    "-c" "")
  134.                    (if *common-source-directory*
  135.                    (expand-file-name *common-source-directory*)
  136.                    "")
  137.                    (if *wais-source-directory*
  138.                    "-s" "")
  139.                    (if *wais-source-directory*
  140.                    (expand-file-name *wais-source-directory*)
  141.                    "")))
  142.       (setq *wais-process* 
  143.         (start-process "WAIS" *wais-receiving-buffer*
  144.                    waisq-program "-"
  145.                    "-m"
  146.                    (format "%d" *wais-maximum-result-documents*)
  147.                    (if *common-source-directory*
  148.                    "-c" "")
  149.                    (if *common-source-directory*
  150.                    (expand-file-name *common-source-directory*)
  151.                    "")
  152.                    (if *wais-source-directory*
  153.                    "-s" "")
  154.                    (if *wais-source-directory*
  155.                    (expand-file-name *wais-source-directory*)
  156.                    "")))))
  157.     (process-kill-without-query *wais-process*)
  158.     (sit-for 3))
  159.   (let ((b (current-buffer)))
  160.     (set-buffer *wais-receiving-buffer*)
  161.     (emacs-lisp-mode)
  162.     (set-buffer b))
  163.   *wais-process*)
  164.  
  165. (defvar waisk-mode-map nil)
  166.  
  167. (unless waisk-mode-map
  168.   (setq waisk-mode-map (copy-keymap text-mode-map))
  169.   (define-key waisk-mode-map "\C-m" 'wais-query)
  170.   (define-key waisk-mode-map "\C-xk" 'wais-kill-buffer))
  171.  
  172. (defun waisk-mode ()
  173.   "Major mode for editting words for the question.
  174.  
  175. All the usual text-mode cursor movement works, except
  176.  
  177. RET     Go for it (answer the Question).
  178.  
  179. Entering this mode calls value of hook variable waisk-mode-hook."
  180.   (interactive)
  181.   (kill-all-local-variables)
  182.   (setq major-mode 'waisk-mode)
  183.   (setq mode-name "WaisK")
  184.   (use-local-map waisk-mode-map)
  185.   (set-syntax-table text-mode-syntax-table)
  186.   (run-hooks 'waisk-mode-hook))
  187.  
  188. (defvar wais-document nil)
  189.  
  190. (defvar waisd-mode-map nil)
  191.  
  192. (unless waisd-mode-map
  193.   (setq waisd-mode-map (copy-keymap text-mode-map))
  194.   (define-key waisd-mode-map "?" 'waisd-help)
  195.   (define-key waisd-mode-map "h" 'waisd-help)
  196.   (define-key waisd-mode-map "B" 'waisd-best-line)
  197.   (define-key waisd-mode-map "s" 'wais-add-section)
  198.   (define-key waisd-mode-map "\r" 'wais-query)
  199.   (define-key waisd-mode-map " " 'scroll-up)
  200.   (define-key waisd-mode-map "\C-?" 'scroll-down)
  201.   (define-key waisd-mode-map "q" 'waisd-exit))
  202.  
  203. (defvar *waisd-mode-string*
  204.     "Major mode in effect in a wais document buffer.
  205.  
  206.    Movement commands:
  207.  
  208.    All the usual text-mode cursor movement work.
  209.    In addition the following commands are available:
  210.  
  211.    B       Go to the best line in the document
  212.    space   Scroll document forward.
  213.    delete  Scroll document backward.
  214.  
  215.    Action Commands:
  216.  
  217.    s       Add the marked region as a section to the Relevant Documents.
  218.    ? or h  Show this message (Help).
  219.    q       quit reading this document.  bury this buffer, and the Question
  220.            buffer associated with it.
  221.  
  222.    When you retrieve a source you will see the source description form in
  223.    the document buffer.  To save this for use in subsequent searches,
  224.    simply use the \"S\" command in the results window, or the standard
  225.    Emacs save-file function (control-x control-s, or M-x save-file).  If
  226.    you use the save-file function, be sure to add the .src suffix so the
  227.    interface will recognize this as a source.  The \"S\" function will add
  228.    the suffix for you.
  229.  
  230. Entering this mode calls value of hook variable waisd-mode-hook."
  231. )
  232.  
  233. (defun waisd-mode ()
  234.   "Major mode for WAIS documents.  Use M-x waisd-help for more information."
  235.   (interactive)
  236.   (kill-all-local-variables)
  237.   (make-variable-buffer-local 'wais-document)
  238.   (make-variable-buffer-local 'current-question)
  239.   (make-variable-buffer-local 'current-question-filename)
  240.   (make-variable-buffer-local 'question-name)
  241.   (make-variable-buffer-local 'wais-best-line)
  242.   (setq wais-document t)
  243.   (setq major-mode 'waisd-mode)
  244.   (setq mode-name "Wais DOC")
  245.   (use-local-map waisd-mode-map)
  246.   (set-syntax-table text-mode-syntax-table)
  247.   (run-hooks 'waisd-mode-hook))
  248.  
  249. (defvar waisq-mode-map nil)
  250.  
  251. (defun init-waisq-mode-map ()
  252.   (suppress-keymap waisq-mode-map)
  253.   (define-key waisq-mode-map "n" 'wais-edit-next-msg)
  254.   (define-key waisq-mode-map "p" 'wais-edit-previous-msg)
  255.   (define-key waisq-mode-map "\C-n" 'wais-next-msg)
  256.   (define-key waisq-mode-map "\C-p" 'wais-previous-msg)
  257.   (define-key waisq-mode-map "+" 'wais-edit-next-resdoc)
  258.   (define-key waisq-mode-map "-" 'wais-edit-previous-resdoc)
  259.   (define-key waisq-mode-map "a" 'wais-add-reldoc)
  260.   (define-key waisq-mode-map "d" 'wais-delete-reldocs)
  261.   (define-key waisq-mode-map "A" 'wais-add-source)
  262.   (define-key waisq-mode-map "D" 'wais-delete-sources)
  263.   (define-key waisq-mode-map "g" 'wais-query)
  264.   (define-key waisq-mode-map "G" 'wais-query)
  265.   (define-key waisq-mode-map "\r" 'wais-query)
  266.   (define-key waisq-mode-map "q" 'wais-exit)
  267.   (define-key waisq-mode-map "Q" 'wais-quit)
  268.   ;;more to come:
  269.   (define-key waisq-mode-map "e" 'wais-edit)
  270.   (define-key waisq-mode-map "f" 'wais-edit)
  271.   (define-key waisq-mode-map "v" 'wais-edit)
  272.   (define-key waisq-mode-map "h" 'wais-help)
  273.   (define-key waisq-mode-map "?" 'wais-help)
  274.   (define-key waisq-mode-map "N" 'wais-create-question)
  275.   (define-key waisq-mode-map "k" 'wais-goto-keywords)
  276.   (define-key waisq-mode-map "K" 'wais-goto-keywords)
  277.   (define-key waisq-mode-map " " 'wais-scroll-msg-up)
  278.   (define-key waisq-mode-map "" 'wais-scroll-msg-down)
  279.   (define-key waisq-mode-map "s" 'wais-select-question)
  280.   (define-key waisq-mode-map "S" 'wais-save-document)
  281.   (define-key waisq-mode-map "m" 'wais-toggle-multiple-buffers)
  282.   (define-key waisq-mode-map "B" 'waisq-best-line)
  283.   (define-key waisq-mode-map "\C-l" 'wais-redisplay)
  284.   (define-key waisq-mode-map "\C-xk" 'wais-kill-buffer))
  285.  
  286. (unless waisq-mode-map
  287.   (setq waisq-mode-map (make-keymap))
  288.   (init-waisq-mode-map))
  289.  
  290. (defvar *waisq-mode-string*
  291.     "Major mode in effect in a wais question buffer.
  292.  
  293.    Movement commands:
  294.  
  295.    C-n     Move to next document, or arg documents.
  296.    C-p     Move to previous document, or arg documents.
  297.    e,f,v   Edit, Find or View the current document (all are synonymous).
  298.    n       Edit to next document, or arg documents.
  299.    p       Edit to previous document, or arg documents.
  300.    space   Scroll document in other window forward.
  301.    delete  Scroll document backward.
  302.    B       Go to the best line in the document
  303.    C-l     Refresh Display and reset Question Window.
  304.  
  305.    Sources:
  306.  
  307.    A       Add a source to the question.
  308.    D       Delete all sources from the question.
  309.  
  310.    Relevance Feedback:
  311.  
  312.    a       Add the current document to the question.
  313.    d       Delete all relevant documents from the question.
  314.  
  315.    Action Commands:
  316.  
  317.    k       Replace the 'Find documents on' words
  318.    G,RET   Go for it (submit the query).
  319.    N       Make a new question.
  320.    m       Toggle multiple document buffer mode. 
  321.    s       Select another question.
  322.    S       Save this document to a file.
  323.    ? or h  Show this message (Help).
  324.    q       quit WaisQ, but keep the question's buffer.
  325.    Q       Quit WaisQ and kill this question's buffer.
  326.  
  327.    New users should try M-x wais-novice.
  328.  
  329.    Entering this mode calls value of hook variable waisq-mode-hook.
  330.  
  331.    Some notes on retrieving and saving sources (from the directory of servers,
  332.    or from the help query):
  333.  
  334.    When you retrieve a source you will see the source description form in
  335.    the document buffer.  To save this for use in subsequent searches,
  336.    simply use the \"S\" command in the results window, or the standard
  337.    Emacs save-file function (control-x control-s, or M-x save-file).  If
  338.    you use the save-file function, be sure to add the .src suffix so the
  339.    interface will recognize this as a source.  The \"S\" function will add
  340.    the suffix for you.
  341. ")
  342.  
  343. (defun wais-help ()
  344.   "Display the special commands available in WaisQ mode"
  345.   (interactive)
  346.   (let ((waisqp (and (boundp 'question-name)
  347.              question-name)))
  348.     (when waisqp
  349.       (wais-redisplay-internal)
  350.       (when wais-split
  351.     (setq wais-split nil)
  352.     (split-window (get-buffer-window (current-buffer))*wais-document-display-size*))
  353.       (other-window 1))
  354.     (switch-to-buffer (get-buffer-create "*Help*"))
  355.     (erase-buffer)
  356.     (unless waisqp
  357.       (insert "                            Gnu Emacs WAIS.
  358.  
  359. Use M-x wais, M-x wais-select-question or M-x wais-create-question 
  360. to get into WaisQ mode.
  361.  
  362. "))
  363.     (insert *waisq-mode-string*)
  364.     (newline 2)
  365.     (insert "  Configuration variables:")
  366.     (newline 2)
  367.     (insert "  Using multiple Document buffers: "
  368.         (if *wais-multiple-document-buffers*
  369.         "Yes." "No."))
  370.     (goto-char (point-min))
  371.     (if waisqp
  372.     (other-window -1))))
  373.  
  374. (defun waisd-help ()
  375.   "Display the special commands available in WaisQ mode"
  376.   (interactive)
  377.   (switch-to-buffer (get-buffer-create "*Help*"))
  378.   (erase-buffer)
  379.   (insert *waisd-mode-string*)
  380.   (newline 2)
  381.   (insert "  Configuration variables:")
  382.   (newline 2)
  383.   (insert "  Using multiple Document buffers: "
  384.       (if *wais-multiple-document-buffers*
  385.           "Yes." "No."))
  386.   (goto-char (point-min))
  387.   (waisd-mode))
  388.  
  389. (defun waisq-mode ()
  390.   "Major mode for editting WAIS questions.  Use M-x wais-help to see more"
  391.   (interactive)
  392.   (if (check-init-directories)
  393.       (progn
  394.     (wais-create-question "Quick" "?" "directory-of-servers.src")
  395.     (wais-query))
  396.       (progn
  397.     (setq major-mode 'waisq-mode)
  398.     (setq mode-name "WaisQ")
  399.     (if (eq wais-buffer-type 'keys)
  400.         (use-local-map waisk-mode-map)
  401.         (use-local-map waisq-mode-map))
  402.     (make-variable-buffer-local 'wais-buffer-type)
  403.     (make-variable-buffer-local 'question-name)
  404.     (make-variable-buffer-local 'current-question-filename)
  405.     (make-variable-buffer-local 'current-question)
  406.     (make-variable-buffer-local 'headlines)
  407.     (make-variable-buffer-local 'wais-split)
  408.     (setq wais-split t)
  409.     (setq truncate-lines *waisq-truncate-mode*)
  410.     (setq buffer-read-only t)
  411.     (setq tab-width 5)
  412.     (set-syntax-table emacs-lisp-mode-syntax-table)
  413.     (run-hooks 'waisq-mode-hook))))
  414.  
  415. (defun load-question (file)
  416.   (let ((filename (expand-file-name (concat *wais-question-directory* file))))
  417.     (load-question-internal filename file)))
  418.  
  419. (defun quiet-replace-string (from-string to-string)
  420.   (while (search-forward from-string nil t)
  421.     (replace-match to-string t t)))
  422.  
  423. (defun load-question-internal (filename name)
  424.   (find-file filename)
  425.   (emacs-lisp-mode)
  426.   (goto-char (point-min))
  427.   (save-excursion
  428.     (quiet-replace-string "#s(" "("))
  429.   (save-excursion
  430.     (quiet-replace-string "#(" "("))
  431.   (save-excursion
  432.     (quiet-replace-string "d003" ""))
  433.   (save-excursion
  434.     (quiet-replace-string "d004" ""))
  435.   (save-excursion
  436.     (quiet-replace-string "(" ""))
  437.   (save-excursion
  438.     (quiet-replace-string ")" ""))
  439.   (save-excursion
  440.     (quiet-replace-string "
  441. \"" "\""))
  442.   (save-excursion
  443.     (quiet-replace-string "" ""))
  444.   (save-excursion
  445.     (quiet-replace-string "" ""))
  446.   (save-excursion
  447.     (quiet-replace-string "
  448. \"" "\""))
  449.   (let ((result (read (current-buffer))))
  450.     (set-buffer-modified-p nil)
  451.     (kill-buffer (current-buffer))
  452.     result))
  453.  
  454. (defun dateof (date)
  455.   (if (= (length date) 6)
  456.       (let ((result (make-string 8 ?/)))
  457.     (setf (aref result 0) (aref date 2))
  458.     (setf (aref result 1) (aref date 3))
  459.     (setf (aref result 3) (aref date 4))
  460.     (setf (aref result 4) (aref date 5))
  461.     (setf (aref result 6) (aref date 0))
  462.     (setf (aref result 7) (aref date 1))
  463.     result)
  464.       ""))
  465.  
  466. (defun any-from-anystring (anystring)
  467.   "return an elisp any from a string that contains an any"
  468.   (let ((l (length anystring)))
  469.     (dotimes (i l)
  470.       (if (= (aref anystring i) ?#)
  471.       (setf (aref anystring i) 32))))
  472.   (read anystring))
  473.  
  474. (defun anystring-to-string (anystring)
  475.   "creates a regular old string from an anystring"
  476.   (any-to-string (any-from-anystring anystring)))
  477.  
  478. (defun any-to-string (any)
  479.   "create a string from an elisp ANY"
  480.   (let* ((size (second (member ':size any)))
  481.      (bytes (second (member ':bytes any)))
  482.      (result (make-string size 0))
  483.      (i 0))
  484.     (dolist (el bytes)
  485.       (setf (aref result i) el)
  486.       (incf i))
  487.     result))
  488.  
  489. (defun string-to-any (string)
  490.   "create an elisp any from a STRING"
  491.   (let ((l (length string))
  492.     bytes)
  493.     (dotimes (i l)
  494.       (push (aref string i) bytes))
  495.     (list ':any ':size l ':bytes (reverse bytes))))
  496.  
  497. (defun print-any (any)
  498.   "Returns a string which is the printed representation of an any"
  499.   (let* ((size (second (member ':size any)))
  500.      (bytes (second (member ':bytes any)))
  501.      (result (format "(:any :size %d :bytes #( " size)))
  502.     (dolist (el bytes)
  503.       (setq result (concat result (format "%d " el))))
  504.     (concat result ") )")))
  505.  
  506. (defun get-keys (question)
  507.   (second (member ':seed-words question)))
  508.  
  509. (defun get-reldocs (question)
  510.   (second (member ':relevant-documents question)))
  511.  
  512. (defun get-sources (question)
  513.   (second (member ':sources question)))
  514.  
  515. (defun get-resdocs (question)
  516.   (second (member ':result-documents question)))
  517.  
  518. (defun get-document (docid)
  519.   (second (member ':document docid)))
  520.  
  521. (defun get-score (docid)
  522.   (second (member ':score docid)))
  523.  
  524. (defun get-type (docid)
  525.   (second (member ':type docid)))
  526.  
  527. (defun get-headline (document)
  528.   (second (member ':headline document)))
  529.  
  530. (defun get-date (document)
  531.   (second (member ':date document)))
  532.  
  533. (defun get-size (document)
  534.   (second (member ':number-of-bytes document)))
  535.  
  536. (defun get-start (docid)
  537.   (second (member ':line-pos
  538.           (second (member ':start docid)))))
  539.  
  540. (defun get-end (docid)
  541.   (second (member ':line-pos
  542.           (second (member ':end docid)))))
  543.  
  544. (defun headlist (doclist)
  545.   (let ((result nil)
  546.     document)
  547.     (dolist (docid doclist)
  548.       (setq document (get-document docid))
  549.       (push (list (get-score docid)
  550.           (get-headline document)
  551.           (get-date document)
  552.           (get-size document))
  553.         result))
  554.     (reverse result)))
  555.  
  556. (defun rellist (doclist)
  557.   (let ((result nil)
  558.     document)
  559.     (dolist (docid doclist)
  560.       (setq document (get-document docid))
  561.       (push (list (get-start docid)
  562.           (get-end docid)
  563.           (get-headline (get-document docid))
  564.           (get-date document))
  565.         result))
  566.     (reverse result)))
  567.  
  568. (defun get-sourcename (source)
  569.   (second (member ':filename source)))
  570.  
  571. (defun sourcelist (sourcelist)
  572.   (let ((result nil))
  573.     (dolist (sid sourcelist)
  574.       (push (get-sourcename sid)
  575.         result))
  576.     (reverse result)))
  577.  
  578. (defun find-wais-buffer (name type)
  579.   (let ((result (get-buffer name)))
  580.     (unless result
  581.       (setq result (get-buffer-create name))
  582.       (switch-to-buffer result)
  583.       (setq wais-buffer-type type)
  584.       (waisq-mode))
  585.     (switch-to-buffer result)
  586.     (waisq-mode)
  587.     result))
  588.  
  589. (defun wais-redisplay-internal ()
  590.   (if (and (boundp 'question-name)
  591.        question-name)
  592.       (let ((name question-name))
  593.     (setup-wais-display name)
  594.     (if (not (eql name question-name))
  595.         (display-question name)))
  596.     (error "Not a question buffer.")))
  597.  
  598. (defun wais-redisplay ()
  599.   "Rebuild the WAISQ display"
  600.   (interactive)
  601.   (wais-redisplay-internal)
  602.   (recenter))
  603.  
  604. (defun setup-wais-display (name)
  605.   (let ((buff (find-wais-buffer (concat name ": Find Documents On")
  606.                 'keys)))
  607.     (delete-other-windows)
  608.     (split-window
  609.      (get-buffer-window buff) 4))
  610.   (setq mode-line-format "-Find Documents On-----%p-%-")
  611.   (setq buffer-read-only nil)
  612.   (other-window 1)
  613.   (split-window
  614.    (get-buffer-window
  615.     (find-wais-buffer (concat name ": On Sources") 'source))
  616.    4)
  617.   (setq mode-line-format '(20 "-On Sources---%p-%-"))
  618.   (other-window 1)
  619.   (find-wais-buffer (concat name ": Results") 'result)
  620.   (setq wais-split t)
  621.   (other-window -1)
  622.   (split-window-horizontally 20)
  623.   (other-window 1)
  624.   (find-wais-buffer (concat name ": Similar To") 'relevant)
  625.   (setq mode-line-format "--Similar To------%p-%-")  
  626.   (other-window 1))
  627.  
  628. (defun set-buffer-variables (question name filename resheads)
  629.   (setq current-question question)
  630.   (setq question-name name)
  631.   (setq current-question-filename filename)
  632.   (setq headlines resheads)
  633.   (setq default-directory *wais-question-directory*)
  634.   (set-buffer-modified-p nil))
  635.  
  636. (defun display-question (name &optional file message)
  637.   (let ((q (if file
  638.            (load-question-internal file name)
  639.            (load-question name))))
  640.     (display-question-internal 
  641.      (if file file (expand-file-name (concat *wais-question-directory* name)))
  642.      name q message)))
  643.  
  644. (defun insert-headline (line)
  645.   (insert 
  646.     (concat "" (first line) "    "
  647.         (if *wais-show-size*
  648.         (if (< (fourth line) 1024)
  649.             (format "%d\t" (fourth line))
  650.             (format "%dK\t" (/ (fourth line) 1024)))
  651.         "")
  652.         (if *wais-show-date*
  653.         (if (string= (third line) "0")
  654.             " No Date  "
  655.             (concat "(" (dateof (third line)) ") "))
  656.         "")))
  657.   (let* ((headline (second line))
  658.      (l (length headline))
  659.      c)
  660.     (dotimes (i l)
  661.       (setq c (aref headline i))
  662.       (insert c)
  663.       (if (= c 10)
  664.       (insert "                ")))))
  665.  
  666. (defun display-question-internal (filename name q &optional message)
  667.   (let ((keys (get-keys q))
  668.     (sourcenames (sourcelist (get-sources q)))
  669.     (relheads (rellist (get-reldocs q)))
  670.     (resheads (headlist (get-resdocs q)))
  671.     keybuff sourcebuff relbuff resbuff)
  672.     (setup-wais-display name)
  673.     (if message (message message))
  674.     (setq keybuff (find-wais-buffer (concat name ": Find Documents On") 'keys))
  675.     (setq buffer-read-only nil)
  676.     (erase-buffer)
  677.     (insert keys)
  678.     (goto-char (point-min))
  679.     (set-buffer-variables q name filename resheads)
  680.     (setq sourcebuff (find-wais-buffer (concat name ": On Sources") 'source))
  681.     (setq buffer-read-only nil)
  682.     (erase-buffer)
  683.     (setq truncate-lines *waisq-truncate-mode*)
  684.     (auto-fill-mode -1)
  685.     (set-buffer-variables q name filename resheads)
  686.     (if sourcenames
  687.     (let ((sorted-sourcenames
  688.            (sort sourcenames
  689.              '(lambda (a b) (string< a b)))))
  690.       (dolist (line sorted-sourcenames)
  691.         (insert (concat " " line))
  692.         (newline)))
  693.     (insert " No Sources"))
  694.     (goto-char (point-min))
  695.     (setq buffer-read-only t)
  696.     (setq relbuff (find-wais-buffer (concat name ": Similar To") 'relevant))
  697.     (setq buffer-read-only nil)
  698.     (erase-buffer)
  699.     (setq truncate-lines *waisq-truncate-mode*)
  700.     (auto-fill-mode -1)
  701.     (set-buffer-variables q name filename resheads)
  702.     (if relheads
  703.     (dolist (line relheads)
  704.       (if (first line)
  705.           (insert (format " [%d,%d] %s%s"
  706.                   (first line) (second line)
  707.                   (if (string= (fourth line) "0")
  708.                   "" (concat "(" (dateof (fourth line)) ") "))
  709.                   (third line)))
  710.           (insert (concat " "
  711.                   (if (string= (fourth line) "0")
  712.                   "" (concat "(" (dateof (fourth line)) ") "))
  713.                   (third line))))
  714.       (newline))
  715.     (insert " No documents"))
  716.     (goto-char (point-min))
  717.     (setq buffer-read-only t)
  718.     (setq resbuff (find-wais-buffer (concat name ": Results") 'result))
  719.     (setq buffer-read-only nil)
  720.     (erase-buffer)
  721.     (setq truncate-lines *waisq-truncate-mode*)
  722.     (auto-fill-mode -1)
  723.     (set-buffer-variables q name filename resheads)
  724.     (if resheads
  725.     (progn
  726.       (dolist (line resheads)
  727.         (insert-headline line)
  728.         (newline))
  729.       (delete-char -1))
  730.     (insert "No documents"))
  731.     (goto-char (point-min))
  732.     (setq buffer-read-only t)
  733.     q))
  734.  
  735. (defun wais-next-line ()
  736.   (while (string-equal (buffer-substring (point) (1+ (point))) "    ")
  737.     (next-line 1)
  738.     (beginning-of-line nil)))
  739.  
  740. (defun wais-prev-line ()  
  741.   (do () 
  742.       ((not (string-equal (buffer-substring (point) (1+ (point))) "    ")))
  743.     (next-line -1)
  744.     (beginning-of-line nil)))
  745.  
  746. (defun wais-next-msg (number)
  747.   "Move the cursor to the next (arg) Document"
  748.   (interactive "p")
  749.   (if (null number) (setq number 1))
  750.   (let ((direction (if (plusp number) 1 -1)))
  751.     (dotimes (i (abs number))
  752.       (next-line direction)
  753.       (if (> direction 0)
  754.       (wais-next-line)
  755.       (wais-prev-line)))))
  756.  
  757. (defun wais-previous-msg (number)
  758.   "Move the cursor to the previous (arg) Document"
  759.   (interactive "p")
  760.   (wais-next-msg (- (if number number 1))))
  761.  
  762. (defun wais-edit (&optional n)
  763.   "Retrieve the Current Document"
  764.   (interactive "p")
  765.   (wais-edit-next-msg 0))
  766.  
  767. (defun line-to-doc ()
  768.   (save-excursion
  769.     (beginning-of-line nil)
  770.     (let ((here (point))
  771.       (result 1))
  772.       (goto-char (point-min))
  773.       (while (< (point) here)
  774.     (wais-next-msg 1)
  775.     (incf result))
  776.       result)))
  777.  
  778. (defun wais-edit-next-msg (&optional n)
  779.   "Retrieve the next (arg) Document"
  780.   (interactive "p")
  781.   (wais-next-msg n)
  782.   (edit-document current-question-filename (line-to-doc)))
  783.  
  784. (defun wais-edit-previous-msg (&optional n)
  785.   "Retrieve the previous (arg) Document"
  786.   (interactive "p")
  787.   (wais-edit-next-msg (if n (- n) -1)))
  788.  
  789. (defun show-dialog (time &optional size message)
  790.   (unless size
  791.     (setq size 4))
  792.   (cond ((< (window-height) (+ 2 size))
  793.      ;;dont split window, too small
  794.      (save-excursion
  795.        (switch-to-buffer *wais-receiving-buffer*)
  796.        (goto-char (point-min))
  797.        (if (numberp time)
  798.            (progn (if message
  799.               (message message))
  800.               (sit-for time))
  801.            (read-input (concat (if message message "")
  802.                    " Press return to continue")))))
  803.     (t
  804.       (save-window-excursion
  805.         (split-window (get-buffer-window (current-buffer)) 
  806.               (- (window-height) size))
  807.         (other-window 1)
  808.         (switch-to-buffer *wais-receiving-buffer*)
  809.         (save-excursion
  810.           (goto-char (point-min))
  811.           (if (numberp time)
  812.           (progn (if message
  813.                  (message message))
  814.              (sit-for time))
  815.           (read-input (concat (if message message "")
  816.                       " Press return to continue"))))
  817.         (bury-buffer (current-buffer))))))
  818.  
  819. (defun wais-query (&optional stuff)
  820.   "Answer this Question"
  821.   (interactive)
  822.   (let (result
  823.     file
  824.     (message "Asking the question..."))
  825.     (update-keywords question-name)
  826.     (wais-redisplay-internal)
  827.     (setq buffer-read-only nil)
  828.     (erase-buffer)
  829.     (setq buffer-read-only t)
  830.     (sit-for 0)
  831.     (message message)
  832.     (setq file current-question-filename)
  833.     (setq name question-name)
  834.     (setq result
  835.       (wais-query-internal file name message))
  836.     (message "Asking the question...done.")
  837.     (if result
  838.     (save-excursion
  839.       (set-buffer *wais-receiving-buffer*)
  840.       (goto-char (point-min))
  841.       (search-forward "Found")
  842.       (beginning-of-line)
  843.       (message (buffer-substring (point)
  844.                      (progn
  845.                        (end-of-line)
  846.                        (point)))))
  847.     (display-question name file
  848.               "Incomplete Transaction.  Question Unmodified."))))
  849.  
  850. (defun update-keywords (name)
  851.   (save-excursion
  852.     (set-buffer 
  853.       (find-wais-buffer (concat name ": Find Documents On")
  854.             'keys))
  855.     (if current-question-filename
  856.     (wais-replace-keywords (buffer-substring (point-min) (point-max))))))
  857.  
  858.  
  859. (defun wais-query-internal (file name &optional message)
  860.   (let (result)
  861.     (update-keywords name)
  862.     (condition-case e
  863.      (let (command-string)
  864.        (find-file file)
  865.        (emacs-lisp-mode)
  866.        (goto-char (point-min))
  867.        (if (search-forward ":result-documents" nil t)
  868.            (setq command-string
  869.              (concat (buffer-substring (point-min)
  870.                            (progn
  871.                          (forward-char -17)
  872.                          (point))) ")"))
  873.            (setq command-string
  874.              (concat (buffer-substring (point-min) (point-max))
  875.                  "
  876. ")))
  877.        (kill-buffer (current-buffer))
  878.        (message message)
  879.        (wais-find-process)
  880.        (set-buffer *wais-receiving-buffer*)
  881.        (erase-buffer)
  882.        (process-send-string (wais-find-process) command-string)
  883.        (accept-process-output (wais-find-process))
  884.        (if (not (eq (process-status *wais-process*) 'run))
  885.            (error "WAIS process died. Look in buffer %s for clues."
  886.               *wais-receiving-buffer*))
  887.        (goto-char (point-min))
  888.        (setq result t)
  889.        (while (not (search-forward " (:question"
  890.                        nil t))
  891.          (accept-process-output *wais-process*)
  892.          (goto-char (point-min))
  893.          (if (or (save-excursion
  894.                (search-forward "Bad Connection"
  895.                        (save-excursion
  896.                      (if (search-forward " (:question" nil t)
  897.                          (point)))
  898.                        t))
  899.              (save-excursion
  900.                (search-forward "Connection refused"
  901.                        (save-excursion
  902.                      (if (search-forward " (:question" nil t)
  903.                          (point)))
  904.                        t)))
  905.          (progn
  906.            (setq result nil)
  907.            (show-dialog t 4 "Looks like a bad connection.")))
  908.          (if (save-excursion
  909.            (search-forward "This Question has no sources"
  910.                    (save-excursion
  911.                      (if (search-forward " (:question" nil t)
  912.                      (point)))
  913.                    t))
  914.          (progn
  915.            (setq result nil)
  916.            (show-dialog t 4 "No Source.  Press 'A' to add one. ")))
  917.          (if (save-excursion
  918.            (re-search-forward "[^\\]Code: [a-zA-Z0-9][a-zA-Z0-9],"
  919.                       (save-excursion
  920.                     (if (search-forward " (:question" nil t)
  921.                         (point)))
  922.                       t))
  923.          (progn
  924.            (show-dialog t 4 "Diagnostic Error")))
  925.          (if (save-excursion
  926.            (search-forward "Couldn't find source"
  927.                    (save-excursion
  928.                      (if (search-forward " (:question" nil t)
  929.                      (point)))
  930.                    t))
  931.          (progn
  932.            (setq result nil)
  933.            (show-dialog t 4 "Looks like a bad source spec.")))
  934.          (if (not (eq (process-status *wais-process*) 'run))
  935.          (error "WAIS process died. Look in buffer %s for clues."
  936.             *wais-receiving-buffer*))
  937.          (goto-char (point-min)))
  938.        (if result
  939.            (progn
  940.          (while (not (search-forward "Waisq: Ready for next question."
  941.                          nil t))
  942.            (accept-process-output *wais-process*)
  943.            (goto-char (point-min)))
  944.          (goto-char (point-min))
  945.          (let ((match "(:question"))
  946.            (search-forward match)
  947.            (setq command-string
  948.              (buffer-substring
  949.                (- (point) (length match))
  950.                (let ((end "Waisq: Ready for next question."))
  951.                  (search-forward end)
  952.                  (forward-char (- (length end)))
  953.                  (point))))
  954.            (find-file file)
  955.            (erase-buffer)
  956.            (insert command-string)
  957.            (let ((require-final-newline nil))
  958.              (save-buffer 0))
  959.            (kill-buffer (current-buffer))
  960.            (setq message (format "%sdone." message))
  961.            (message message)
  962.            (display-question name
  963.                      file message)))))
  964.        (error
  965.      (show-dialog t 6 "Something wrong with query"))
  966.        (quit
  967.      (display-question name file)
  968.      (message "Abort Query!")
  969.      (unless *debug*
  970.        (kill-buffer *wais-receiving-buffer*))))
  971.     result))
  972.  
  973. (defun get-source-filename (file)
  974.   "Get source file name, adding .src if necessary"
  975.   (interactive "FSource file name: ")
  976.   (if (null file)
  977.       (setq file
  978.         (read-file-name "Source file name: ")))
  979.   (let ((len (length file)))
  980.     (if (string= (substring file -4) ".src")
  981.           file
  982.           (concat file ".src"))))
  983.  
  984. (defun wais-save-document (&rest foo)
  985.   "Save this document to a file"
  986.   (interactive)
  987.   (wais-edit)
  988.   (condition-case foo
  989.        (progn
  990.      (other-window 1)
  991.      (if (string= default-directory *wais-source-directory*)
  992.          (write-file (get-source-filename nil))
  993.          (save-buffer))
  994.      (other-window -1))
  995.      (quit
  996.        (message "Abort!")
  997.        (wais-redisplay))))
  998.   
  999.  
  1000. (defun wais-exit (&optional foo)
  1001.   "Leave this Question"
  1002.   (interactive)
  1003.   (let ((current (current-buffer)))
  1004.     (bury-doc-buffers)
  1005.     (switch-to-buffer current))
  1006.   (wais-redisplay-internal)
  1007.   (delete-other-windows)
  1008.   (dotimes (i 4)
  1009.     (bury-buffer))
  1010.   (if (member major-mode 
  1011.           '(waisq-mode waisd-mode waisk-mode))
  1012.       (wais-redisplay-internal)))
  1013.  
  1014. (defun wais-quit (&optional foo)
  1015.   "Kill this Question (and all it's buffers)"
  1016.   (interactive)
  1017.   (let ((current (current-buffer)))
  1018.     (bury-doc-buffers)
  1019.     (switch-to-buffer current))
  1020.   (wais-redisplay-internal)
  1021.   (delete-other-windows)
  1022.   (dotimes (i 4)
  1023.     (kill-buffer (current-buffer)))
  1024.   (and (get-buffer *wais-receiving-buffer*) 
  1025.        (kill-buffer *wais-receiving-buffer*))
  1026.   (if (member major-mode 
  1027.           '(waisq-mode waisd-mode waisk-mode))
  1028.       (wais-redisplay-internal)))
  1029.  
  1030. (defun waisd-exit (&optional foo)
  1031.   "Burry this Document buffer, and the Question that made it"
  1032.   (interactive)
  1033.   (other-window -1)
  1034.   (let ((current (current-buffer)))
  1035.     (bury-doc-buffers)
  1036.     (switch-to-buffer current))
  1037.   (wais-redisplay-internal)
  1038.   (delete-other-windows)
  1039.   (dotimes (i 4)
  1040.     (bury-buffer))
  1041.     (if (member major-mode 
  1042.           '(waisq-mode waisd-mode waisk-mode))
  1043.       (wais-redisplay-internal)))
  1044.  
  1045. ;;; to make kill-buffer a little more tollerant:
  1046.  
  1047. (defun wais-kill-buffer (&rest args)
  1048.   (interactive)
  1049.   (if (eq major-mode 'waisq-mode)
  1050.       (if (yes-or-no-p "Really kill this question? ")
  1051.       (wais-quit))))
  1052.  
  1053. (defun get-resdoc (num file)
  1054.   (let (result)
  1055.     (save-excursion
  1056.       (find-file file)
  1057.       (emacs-lisp-mode)
  1058.       (goto-char (point-min))
  1059.       (search-forward ":result-documents")
  1060.       (search-forward ":document-id" nil t num)
  1061.       (let ((loc (- (point) 15)))
  1062.     (goto-char loc)
  1063.     (forward-char 13)
  1064.     (if (search-forward ":document-id" nil t)
  1065.         ;;(forward-sexp 1) - doesn't work correctly.
  1066.         (setq result (buffer-substring loc (- (point) 13)))
  1067.         (goto-char (1- (point-max)))
  1068.         (dotimes (i 2)
  1069.           (while (not (string= (buffer-substring (point) (1+ (point)))
  1070.                    ")"))
  1071.         (backward-char)))
  1072.         (setq result (buffer-substring loc (- (point) 13)))))
  1073.       (kill-buffer (current-buffer)))
  1074.     result))
  1075.  
  1076. (defun next-or-prev-doc (doc nextp)
  1077.   (let ((obuf (current-buffer))
  1078.     (buf (get-buffer-create " *wais-resdoc-tmp-buffer"))
  1079.     result)
  1080.     (switch-to-buffer buf)
  1081.     (erase-buffer)
  1082.     (insert doc)
  1083.     (goto-char (point-min))
  1084.     (search-forward ":type")
  1085.     (kill-line)
  1086.     (insert 
  1087.       (if nextp
  1088.       " \"WAIS_NEXT\""
  1089.       " \"WAIS_PREV\""))
  1090.     (setq result (buffer-substring (point-min) (point-max)))
  1091.     (kill-buffer buf)
  1092.     (switch-to-buffer obuf)
  1093.     result))
  1094.  
  1095. (defun wais-add-reldoc (&optional num)
  1096.   "Add the current Document to the Question"
  1097.   (interactive)
  1098.   (let* ((doc (current-line))
  1099.      (line (second (nth (1- doc) headlines)))
  1100.      (file current-question-filename)
  1101.      (name question-name))
  1102.     (update-keywords name)
  1103.     (save-excursion
  1104.       (let ((string (get-resdoc doc file)))
  1105.     (find-file file)
  1106.     (goto-char (point-min))
  1107.     (search-forward ":relevant-documents")
  1108.     (search-forward "( ")
  1109.     (insert string))
  1110.       (let ((require-final-newline nil))
  1111.     (save-buffer 0))
  1112.       (kill-buffer (current-buffer))
  1113.       (display-question name))
  1114.     (find-wais-buffer (concat name ": Results") 'result)
  1115.     (goto-line doc)))
  1116.  
  1117. (defun wais-delete-reldocs (&optional num)
  1118.   "Remove all 'Similar To' Documents from this Question"
  1119.   (interactive)
  1120.   (let ((doc (current-line))
  1121.     (file current-question-filename)
  1122.     (name question-name))
  1123.     (update-keywords name)
  1124.     (find-file file)
  1125.     (emacs-lisp-mode)
  1126.     (goto-char (point-min))
  1127.     (search-forward ":relevant-documents")
  1128.     (search-forward "(")
  1129.     (backward-char 1)
  1130.     (let ((loc (point)))
  1131.       (forward-sexp 1)
  1132.      (setq loc (point))
  1133.      (forward-sexp -1)
  1134.      (delete-char (- loc (point)))
  1135.      (insert "(  )
  1136.       "))
  1137.        (let ((require-final-newline nil))
  1138.      (save-buffer 0))
  1139.        (kill-buffer (current-buffer))
  1140.        (display-question name current-question-filename)
  1141.        (goto-line doc)))
  1142.  
  1143. (defun get-doc-type (document)
  1144.   (second (member ':type document)))
  1145.  
  1146. (defun get-doc-best-line (document)
  1147.   (second (member ':best-line document)))
  1148.  
  1149. (defun type-from-number (question number)
  1150.   (get-doc-type (get-document (nth (1- number)
  1151.                    (get-resdocs question)))))
  1152.  
  1153. (defun best-line-from-number (question number)
  1154.   (get-doc-best-line (get-document (nth (1- number)
  1155.                     (get-resdocs question)))))
  1156.  
  1157. (defun get-filename (string)
  1158.   (let ((first-space (do ((i 0 (1+ i)))
  1159.              ((or (= i (length string)) 
  1160.                   (= (aref string i) ? )
  1161.                   (= (aref string i) ?_))
  1162.               i))))
  1163.     (substring string 0 first-space)))
  1164.  
  1165. (defun wais-find-viewer (type)
  1166.   (do ((e (first *x-viewers*) (first rest))
  1167.        (rest (cdr *x-viewers*) (cdr rest)))
  1168.       ((or (string= (first e) type)
  1169.        (null rest))
  1170.        (if (string= (first e) type)
  1171.        (second e)
  1172.        nil))))
  1173.  
  1174. (defun x-view-buffer (name)
  1175.   (let ((buffer (get-buffer name)))
  1176.     (if (null buffer)
  1177.     (generate-new-buffer name)
  1178.     (let ((proc (get-buffer-process buffer)))
  1179.       (if (and proc
  1180.            (eq (process-status proc) 'run))
  1181.           (progn 
  1182.         (message "Already viewing this file!")
  1183.         nil)
  1184.           buffer)))))
  1185.  
  1186. (defun view-sentinel (proc msg)
  1187.   (cond ((null (buffer-name (process-buffer proc)))
  1188.      ;; buffer killed
  1189.      (set-process-buffer proc nil))
  1190.     (t 
  1191.       (let ((b (current-buffer)))
  1192.         (set-buffer (process-buffer proc))
  1193.         (goto-char (point-max))
  1194.         (insert "Done.\n")
  1195.         (set-buffer b)))))
  1196.  
  1197. (defun x-view-file (fname type)
  1198.   (let* ((viewer
  1199.       (wais-find-viewer type))
  1200.      (buffer (x-view-buffer (concat "*xview-" name)))
  1201.      view-process
  1202.      (b (current-buffer))
  1203.      (command (format "%s %s;/bin/rm %s" viewer fname fname)))
  1204.     (if viewer
  1205.     (if buffer
  1206.         (progn
  1207.           (set-buffer buffer)
  1208.           (make-variable-buffer-local 'wais-document)
  1209.           (setq wais-document 0)
  1210.           (erase-buffer)
  1211.           (insert command "\n")
  1212.           (goto-char (point-max))
  1213.           (set-buffer b)
  1214.           (setq view-process
  1215.             (start-process
  1216.               fname buffer
  1217.               "csh"
  1218.               "-fc" command))
  1219.           (set-process-sentinel view-process 'view-sentinel)
  1220.           buffer)
  1221.         (get-buffer (concat "*xview-" name)))
  1222.     (message "unable to view %s, can't find viewer for type: %s" fname type))))
  1223.  
  1224. (defun find-doc-buffer (docid)
  1225.   (do* ((buffers (buffer-list) (cdr buffers))
  1226.     (buff (car buffers) (car buffers)))
  1227.        ((or (null buffers)
  1228.         (and buff
  1229.          (equal docid
  1230.             (save-excursion
  1231.               (set-buffer buff)
  1232.               wais-document))))
  1233.     (if buffers
  1234.         buff nil))))
  1235.  
  1236. (defun fix-wais-name (name)
  1237.   "Replace TABS in NAME with Space so buffer-select works."
  1238.   (dotimes (i (length name))
  1239.     (if (or (= (aref name i) ?    )
  1240.         (= (aref name i) ? ))
  1241.     (setf (aref name i) ?_)))
  1242.   name)
  1243.  
  1244. (defun edit-document (filename document-number)
  1245.   (let ((buff (current-buffer))
  1246.     (result t))
  1247.     (condition-case e
  1248.      (let* ((q current-question)
  1249.         (f current-question-filename)
  1250.         (n question-name)
  1251.         (wais-string (concat "(:question :result-documents ( "
  1252.                      (get-resdoc document-number
  1253.                          current-question-filename)
  1254.                      " ) )
  1255. "))
  1256.         (name (if *wais-multiple-document-buffers*
  1257.               (fix-wais-name (second (nth (1- document-number)
  1258.                               headlines)))
  1259.               *wais-document-buffer*))
  1260.         (document (get-document (nth (1- document-number)
  1261.                          (get-resdocs q))))
  1262.         (buffer (find-doc-buffer document))
  1263.         (lines headlines)
  1264.         (type (type-from-number q document-number))
  1265.         (best-line (best-line-from-number q document-number))
  1266.         (size (second (member ':number-of-bytes
  1267.                       (get-document (nth (1- document-number)
  1268.                              (get-resdocs q)))))))
  1269.        (if (plusp size)
  1270.            (if (and buffer *wais-multiple-document-buffers*)
  1271.            (progn
  1272.              (when wais-split
  1273.                (setq wais-split nil)
  1274.                (split-window (get-buffer-window (current-buffer))
  1275.                      *wais-document-display-size*))
  1276.              (other-window 1)
  1277.              (switch-to-buffer buffer)
  1278.              (other-window -1))
  1279.            (progn
  1280.              (message "Retrieving Document (%s characters)..." size)
  1281.              (wais-find-process)
  1282.              (set-buffer *wais-receiving-buffer*)
  1283.              (erase-buffer)
  1284.              (process-send-string (wais-find-process) wais-string)
  1285.              (accept-process-output *wais-process*)
  1286.              (if (not (eq (process-status *wais-process*) 'run))
  1287.              (error "WAIS process died. Look in buffer %s for clues."
  1288.                 *wais-receiving-buffer*))
  1289.              (while (and result
  1290.                  (not (save-excursion
  1291.                     (goto-char (point-min))
  1292.                     (search-forward "Waisq: Ready for next question." nil t))))
  1293.                ;; check to see if we've got an bad connection
  1294.                (goto-char (point-min))
  1295.                (if (or (save-excursion
  1296.                  (search-forward "Connection refused"
  1297.                          (save-excursion
  1298.                            (if (search-forward "done." nil t)
  1299.                                (point)))
  1300.                          t))
  1301.                    (save-excursion
  1302.                  (search-forward "bad connection"
  1303.                          (save-excursion
  1304.                            (if (search-forward "done." nil t)
  1305.                                (point)))
  1306.                          t)))
  1307.                (progn
  1308.                  (setq result nil)
  1309.                  (show-dialog t 4 "Looks like a bad connection.")
  1310.                  (top-level)))
  1311.                (if (save-excursion
  1312.                  (re-search-forward "[^\\]Code: [a-zA-Z0-9][a-zA-Z0-9],"
  1313.                          (save-excursion
  1314.                            (if (search-forward "done." nil t)
  1315.                            (point)))
  1316.                          t))
  1317.                (progn
  1318.                  (show-dialog t 4 "Diagnostic Error")
  1319.                  (top-level)))
  1320.                (accept-process-output *wais-process*)
  1321.                (if (not (eq (process-status *wais-process*) 'run))
  1322.                (error "WAIS process died. Look in buffer %s for clues."
  1323.                   *wais-receiving-buffer*)))
  1324.              (if result
  1325.              (save-excursion
  1326.                (goto-char (point-min))
  1327.                (save-excursion
  1328.                  (let* ((end-string "Waisq: Ready for next question.")
  1329.                     (size (progn
  1330.                         (search-forward end-string)
  1331.                         (forward-char (- (1+ (length end-string))))
  1332.                         (point))))
  1333.                    (message "Received %d bytes...done." size)
  1334.                    (setq wais-string
  1335.                      (buffer-substring
  1336.                        (point-min)
  1337.                        size))
  1338.                    (switch-to-buffer (if *wais-multiple-document-buffers*
  1339.                              (generate-new-buffer name)
  1340.                              name))
  1341.                    (setq name (buffer-name))
  1342.                    (setq buffer-read-only nil)
  1343.                    (waisd-mode)
  1344.                    (setq wais-document (get-document (nth (1- document-number)
  1345.                                       (get-resdocs q))))
  1346.                    (setq current-question q)
  1347.                    (setq current-question-filename f)
  1348.                    (setq question-name n)
  1349.                    (erase-buffer)
  1350.                    (setq wais-best-line best-line)
  1351.                    (insert wais-string)
  1352.                    (goto-char (point-min))
  1353.                    (cond ((and type (string= type "WSRC"))
  1354.                       (setq default-directory *wais-source-directory*))
  1355.                      ((and type
  1356.                        (not (string= type "TEXT"))
  1357.                        (not (string= type "WCAT")))
  1358.                       (if (getenv "DISPLAY")
  1359.                       (let ((buff (current-buffer))
  1360.                         (fname  (format "%s%s"
  1361.                                 *wais-document-directory*
  1362.                                 (get-filename name))))
  1363.                         (set-visited-file-name fname)
  1364.                         (set-buffer-modified-p t)
  1365.                         (let ((require-final-newline nil))
  1366.                           (save-buffer 0))
  1367.                         (setq name (x-view-file fname type))
  1368.                         (wais-redisplay-internal)
  1369.                         (kill-buffer buff))
  1370.                       (progn
  1371.                         (setq default-directory *wais-document-directory*)
  1372.                         (message "Got a %s document I can't display." type))))
  1373.                      (t (setq default-directory *wais-document-directory*)
  1374.                     (goto-char (point-min))
  1375.                     (if (rmail-p (current-buffer))
  1376.                         (wais-rmail-show-message 1))
  1377.                     (setq buffer-read-only t)))))
  1378.                (switch-to-buffer buff)
  1379.                (progn    ;unless (and (or (string= type "GIF")
  1380.                     ;    (string= type "TIFF"))
  1381.                     ;   (getenv "DISPLAY"))
  1382.                  (when wais-split
  1383.                    (setq wais-split nil)
  1384.                    (split-window (get-buffer-window (current-buffer))
  1385.                          *wais-document-display-size*))
  1386.                  (other-window 1)
  1387.                  (switch-to-buffer name)
  1388.                  (other-window -1)))
  1389.              (show-dialog t 4 "Error retrieving Document"))))
  1390.            (message "Empty Document, nothing to retrieve.")))
  1391.        (errors
  1392.      (switch-to-buffer buff)
  1393.      (wais-redisplay-internal)
  1394.      (show-dialog t 6 "Something wrong with retrieval."))
  1395.        (quit
  1396.      (switch-to-buffer buff)
  1397.      (wais-redisplay-internal)
  1398.      (message "Abort Retrieval!")
  1399.      (unless *debug*
  1400.        (kill-buffer *wais-receiving-buffer*))))
  1401.     (switch-to-buffer buff)))
  1402.  
  1403. (defun resdoc-from-docret (docret)
  1404.   (let* ((b (current-buffer))
  1405.      (c (get-buffer-create "* wais-temp *"))
  1406.      q)
  1407.     (set-buffer c)
  1408.     (erase-buffer)
  1409.     (insert docret)
  1410.     (goto-char (point-min))
  1411.     (quiet-replace-string "#(" "(")
  1412.     (goto-char (point-min))
  1413.     (setq q (read c))
  1414.     (kill-buffer c)
  1415.     (set-buffer b)
  1416.     (first (get-resdocs q))))
  1417.  
  1418. (defun wais-edit-next-resdoc ()
  1419.   "Edit the document cardinally after this document"
  1420.   (interactive)
  1421.   (edit-next-or-previous-document current-question-filename
  1422.                   (current-line) t))
  1423.  
  1424. (defun wais-edit-previous-resdoc ()
  1425.   "Edit the document cardinally after this document"
  1426.   (interactive)
  1427.   (edit-next-or-previous-document current-question-filename
  1428.                   (current-line) nil))
  1429.  
  1430. ;;; this mostly works.  It cannot as yet be called from a keystroke.
  1431. ;;; Need to resolve docid so it doesn't retrieve the document multiple times 
  1432. ;;; if it's alread in a buffer.  That's pretty close!  I think I'll put it
  1433. ;;; on a key. How about + an -!
  1434.  
  1435. (defun edit-next-or-previous-document (filename document-number nextp)
  1436.   (let ((buff (current-buffer))
  1437.     (result t))
  1438.     (condition-case e
  1439.      (let* ((q current-question)
  1440.         (f current-question-filename)
  1441.         (n question-name)
  1442.         (resdoc (next-or-prev-doc
  1443.               (get-resdoc document-number
  1444.                       current-question-filename)
  1445.               nextp))
  1446.         (wais-string (concat "(:question :seed-words \"foo\" :relevant-documents ( "
  1447.                      resdoc
  1448.                      " ) :sources ( "
  1449.                      (format "%s ) " (first (get-sources current-question))) " )
  1450. ")))
  1451.        (progn
  1452.          (wais-find-process)
  1453.          (set-buffer *wais-receiving-buffer*)
  1454.          (erase-buffer)
  1455.          (process-send-string (wais-find-process) wais-string)
  1456.          (accept-process-output *wais-process*)
  1457.          (if (not (eq (process-status *wais-process*) 'run))
  1458.          (error "WAIS process died. Look in buffer %s for clues."
  1459.             *wais-receiving-buffer*))
  1460.          (while (and result
  1461.              (not (save-excursion
  1462.                 (goto-char (point-min))
  1463.                 (search-forward "Waisq: Ready for next question." nil t))))
  1464.            ;; check to see if we've got an bad connection
  1465.            (goto-char (point-min))
  1466.            (if (or (save-excursion
  1467.              (search-forward "Connection refused"
  1468.                      (save-excursion
  1469.                        (if (search-forward "Found" nil t)
  1470.                            (point)))
  1471.                      t))
  1472.                (save-excursion
  1473.              (search-forward "bad connection"
  1474.                      (save-excursion
  1475.                        (if (search-forward "Found" nil t)
  1476.                            (point)))
  1477.                      t)))
  1478.            (progn
  1479.              (setq result nil)
  1480.              (show-dialog t 4 "Looks like a bad connection.")
  1481.              (top-level)))
  1482.            (if (save-excursion
  1483.            (re-search-forward "[^\\]Code: [a-zA-Z0-9][a-zA-Z0-9],"
  1484.                      (save-excursion
  1485.                        (if (search-forward "Found" nil t)
  1486.                        (point)))
  1487.                      t))
  1488.            (progn
  1489.              (show-dialog t 4 "Diagnostic Error")
  1490.              (top-level)))
  1491.            (accept-process-output *wais-process*)
  1492.            (if (not (eq (process-status *wais-process*) 'run))
  1493.            (error "WAIS process died. Look in buffer %s for clues."
  1494.               *wais-receiving-buffer*)))
  1495.          (if result
  1496.          (save-excursion
  1497.            (goto-char (point-min))
  1498.            (save-excursion
  1499.              (let ((size (1- (progn
  1500.                        (goto-char (point-min))
  1501.                        (search-forward "Found")
  1502.                        (next-line 1)
  1503.                        (beginning-of-line)
  1504.                        (point)))))
  1505.                (setq wais-string
  1506.                  (buffer-substring
  1507.                    (point)
  1508.                    (progn
  1509.                  (search-forward "Waisq: Ready for next question.")
  1510.                  (forward-char -31)
  1511.                  (point)))))))))
  1512.        (let* ((docid (resdoc-from-docret wais-string))
  1513.           (document (get-document docid))
  1514.           (name (if *wais-multiple-document-buffers*
  1515.                 (fix-wais-name (get-headline document))
  1516.                 *wais-document-buffer*))
  1517.           (buffer (find-doc-buffer document))
  1518.           (type (get-type docid))
  1519.           (best-line (best-line-from-number q document-number))
  1520.           (size (get-size document)))
  1521.          (if (and buffer *wais-multiple-document-buffers*)
  1522.          (progn
  1523.            (when wais-split
  1524.              (setq wais-split nil)
  1525.              (split-window (get-buffer-window (current-buffer))
  1526.                    *wais-document-display-size*))
  1527.            (other-window 1)
  1528.            (switch-to-buffer buffer)
  1529.            (other-window -1))
  1530.          (progn
  1531.            (setq wais-string
  1532.              (format "(:question :result-documents ( %s ) ) "
  1533.                  docid))
  1534.            (wais-find-process)
  1535.            (set-buffer *wais-receiving-buffer*)
  1536.            (erase-buffer)
  1537.            (process-send-string (wais-find-process) wais-string)
  1538.            (accept-process-output *wais-process*)
  1539.            (if (not (eq (process-status *wais-process*) 'run))
  1540.                (error "WAIS process died. Look in buffer %s for clues."
  1541.                   *wais-receiving-buffer*))
  1542.            (while (and result
  1543.                    (not (save-excursion
  1544.                       (goto-char (point-min))
  1545.                       (search-forward "Waisq: Ready for next question." nil t))))
  1546.              ;; check to see if we've got an bad connection
  1547.              (goto-char (point-min))
  1548.              (if (or (save-excursion
  1549.                    (search-forward "Connection refused"
  1550.                            (save-excursion
  1551.                          (if (search-forward "done." nil t)
  1552.                              (point)))
  1553.                            t))
  1554.                  (save-excursion
  1555.                    (search-forward "bad connection"
  1556.                            (save-excursion
  1557.                          (if (search-forward "done." nil t)
  1558.                              (point)))
  1559.                            t)))
  1560.              (progn
  1561.                (setq result nil)
  1562.                (show-dialog t 4 "Looks like a bad connection.")
  1563.                (top-level)))
  1564.              (if (save-excursion
  1565.                (re-search-forward "[^\\]Code: [a-zA-Z0-9][a-zA-Z0-9],"
  1566.                           (save-excursion
  1567.                         (if (search-forward "done." nil t)
  1568.                             (point)))
  1569.                           t))
  1570.              (progn
  1571.                (show-dialog t 4 "Diagnostic Error")
  1572.                (top-level)))
  1573.              (accept-process-output *wais-process*)
  1574.              (if (not (eq (process-status *wais-process*) 'run))
  1575.              (error "WAIS process died. Look in buffer %s for clues."
  1576.                 *wais-receiving-buffer*)))
  1577.            (if result
  1578.                (save-excursion
  1579.              (goto-char (point-min))
  1580.              (save-excursion
  1581.                (let ((size (1- (progn
  1582.                          (goto-char (point-min))
  1583.                          (search-forward "done.")
  1584.                          (forward-char 1)
  1585.                          (point)))))
  1586.                  (save-excursion
  1587.                    (word-search-backward "Received")
  1588.                    (message "%s...done." (buffer-substring (point) (- size 7))))
  1589.                  (setq wais-string
  1590.                    (buffer-substring
  1591.                      (point)
  1592.                      (progn
  1593.                        (search-forward "Waisq: Ready for next question.")
  1594.                        (forward-char -31)
  1595.                        (point))))))
  1596.              (switch-to-buffer (if *wais-multiple-document-buffers*
  1597.                            (generate-new-buffer name)
  1598.                            name))
  1599.              (setq name (buffer-name))
  1600.              (setq buffer-read-only nil)
  1601.              (waisd-mode)
  1602.              (setq wais-document (get-document docid))
  1603.              (setq current-question q)
  1604.              (setq current-question-filename f)
  1605.              (setq question-name n)
  1606.              (erase-buffer)
  1607.              (setq wais-best-line best-line)
  1608.              (insert wais-string)
  1609.              (goto-char (point-min))
  1610.              (cond ((and type (string= type "WSRC"))
  1611.                 (setq default-directory *wais-source-directory*))
  1612.                    ((and type
  1613.                      (not (string= type "TEXT"))
  1614.                      (not (string= type "WCAT")))
  1615.                 (if (getenv "DISPLAY")
  1616.                     (let ((buff (current-buffer))
  1617.                       (fname  (format "%s%s"
  1618.                               *wais-document-directory*
  1619.                               (get-filename name))))
  1620.                       (set-visited-file-name fname)
  1621.                       (set-buffer-modified-p t)
  1622.                       (let ((require-final-newline nil))
  1623.                     (save-buffer 0))
  1624.                       (setq name (x-view-file fname type))
  1625.                       (wais-redisplay-internal)
  1626.                       (kill-buffer buff))
  1627.                     (progn
  1628.                       (setq default-directory *wais-document-directory*)
  1629.                       (message "Got a %s document I can't display." type))))
  1630.                    (t (setq default-directory *wais-document-directory*)
  1631.                   (goto-char (point-min))
  1632.                   (if (rmail-p (current-buffer))
  1633.                       (wais-rmail-show-message 1))
  1634.                   (setq buffer-read-only t)))
  1635.              (switch-to-buffer buff)
  1636.              (progn
  1637.                (when wais-split
  1638.                  (setq wais-split nil)
  1639.                  (split-window (get-buffer-window (current-buffer))
  1640.                        *wais-document-display-size*))
  1641.                (other-window 1)
  1642.                (switch-to-buffer name)
  1643.                (other-window -1)))
  1644.                (show-dialog t 4 "Error retrieving Document"))))))
  1645.        (errors
  1646.      (switch-to-buffer buff)
  1647.      (wais-redisplay-internal)
  1648.      (show-dialog t 6 "Something wrong with retrieval."))
  1649.        (quit
  1650.      (switch-to-buffer buff)
  1651.      (wais-redisplay-internal)
  1652.      (message "Abort Retrieval!")
  1653.      (unless *debug*
  1654.        (kill-buffer *wais-receiving-buffer*))))
  1655.     (switch-to-buffer buff)))
  1656.  
  1657. (defun waisd-best-line ()
  1658.   (interactive)
  1659.   (if (and (boundp 'wais-best-line)
  1660.        wais-best-line)
  1661.       (goto-line wais-best-line)))
  1662.  
  1663. (defun waisq-best-line ()
  1664.   (interactive)
  1665.   (other-window 1)
  1666.   (waisd-best-line)
  1667.   (other-window -1))
  1668.  
  1669. (defun wais-add-section ()
  1670.   "Add the current region as a section to the document"
  1671.   (interactive)
  1672.   (let ((here (point))
  1673.     (there (mark)))
  1674.     (save-window-excursion
  1675.       (let ((start-line (current-line))
  1676.         (end-line (save-excursion
  1677.             (goto-char there)
  1678.             (current-line))))
  1679.     (if (> start-line end-line)
  1680.         (let ((temp end-line))
  1681.           (setq end-line start-line)
  1682.           (setq start-line temp)))
  1683.     (wais-add-fragment wais-document
  1684.                current-question-filename question-name
  1685.                (1- start-line) (1- end-line))))))
  1686.  
  1687. (defun insert-parts (first second)
  1688.   (if (and first
  1689.        (listp first))
  1690.       (insert-struct first)
  1691.       (insert (format "%s " first)))
  1692.   (if (and second
  1693.        (listp second)
  1694.        (not (eq (first second) ':any)))
  1695.       (progn (newline 1)
  1696.          (insert-struct second))
  1697.       (if (stringp second)
  1698.       (progn
  1699.         (insert "\"")
  1700.         (dotimes (i (length second))
  1701.           (if (= (aref second i) ?\")
  1702.           (insert "\\\"")
  1703.         (insert (aref second i))))
  1704.         (insert "\""))
  1705.       (if (and (listp second)
  1706.            (eq (first second) ':any))
  1707.           (insert-any second)
  1708.           (insert (format "%s" second))))))
  1709.  
  1710. (defun insert-any (any)
  1711.   (insert (format "(%s %s %d %s " 
  1712.           (first any) (second any) (third any) (fourth any)))
  1713.   (insert "#( ")
  1714.   (dolist (n (fifth any))
  1715.     (insert (format "%d " n)))
  1716.   (insert "
  1717. )
  1718. )"))
  1719.  
  1720. (defun insert-struct (struct)
  1721.   (insert "(")
  1722.   (if (and (first struct)
  1723.        (listp (first struct)))
  1724.       (insert-struct (first struct))
  1725.       (insert (format "%s" (first struct)) "
  1726. "))
  1727.     (do ((first (second struct) (first rest))
  1728.      (second (third struct) (second rest))
  1729.      (rest (cdddr struct) (cddr rest)))
  1730.     ((null rest)
  1731.      (insert-parts first second))
  1732.       (insert-parts first second)
  1733.       (newline 1))
  1734.     (insert "
  1735. )"))
  1736.  
  1737. (defun wais-add-fragment (doc file name start end)
  1738.   (update-keywords name)
  1739.   (let ((reldoc (make-doc-fragment doc start end)))
  1740.     (save-excursion
  1741.       (find-file file)
  1742.       (goto-char (point-min))
  1743.       (search-forward ":result-documents")
  1744.       (goto-char (point-min))
  1745.       (search-forward ":relevant-documents")
  1746.       (search-forward "( ")
  1747.       (save-excursion
  1748.     (insert-struct reldoc))
  1749.       (indent-sexp)
  1750.       (let ((require-final-newline nil))
  1751.     (save-buffer 0))
  1752.       (kill-buffer (current-buffer))
  1753.       (display-question name))))
  1754.  
  1755. (defun make-doc-fragment (doc start end)
  1756.   (list ':document-id
  1757.     ':start (list ':fragment ':line-pos start)
  1758.     ':end (list ':fragment ':line-pos end)
  1759.     ':document doc))
  1760.  
  1761. (defun wais-delete-all-documents ()
  1762.   "Delete all WAIS DOC buffers"
  1763.   (interactive)
  1764.   (let ((current-buffer (current-buffer)))
  1765.     (dolist (buf (buffer-list))
  1766.       (set-buffer buf)
  1767.       (when (and (boundp 'wais-document)
  1768.          wais-document)
  1769.     (kill-buffer buf)))))
  1770.  
  1771. (defun bury-doc-buffers ()
  1772.   (let ((current-buffer (current-buffer)))
  1773.     (dolist (buf (buffer-list))
  1774.       (set-buffer buf)
  1775.       (when (and (boundp 'wais-document)
  1776.          wais-document)
  1777.     (switch-to-buffer buf)
  1778.     (bury-buffer buf)))))
  1779.  
  1780. (defun wais-scroll-msg-up (&optional dist)
  1781.   "Scroll other window forward."
  1782.   (interactive "P")
  1783.   (unless wais-split
  1784.     (condition-case foo
  1785.      (scroll-other-window dist)
  1786.        (error (message "Bottom of buffer")))))
  1787.  
  1788. (defun wais-scroll-msg-down (&optional dist)
  1789.   "Scroll other window backward."
  1790.   (interactive "P")
  1791.   (unless wais-split
  1792.     (condition-case foo
  1793.      (scroll-other-window
  1794.        (cond ((eq dist '-) nil)
  1795.          ((null dist) '-)
  1796.          (t (- (prefix-numeric-value dist)))))
  1797.        (error (message "Top of buffer")))))
  1798.  
  1799. (defvar *rmail-header-regex* "*** EOOH ***")
  1800.  
  1801. (defun rmail-p (buffer)
  1802.   (save-excursion
  1803.     (switch-to-buffer buffer)
  1804.     (condition-case rmail-p
  1805.      (re-search-forward *rmail-header-regex*)
  1806.        (error nil))))
  1807.  
  1808. (defun wais-rmail-show-message (n)
  1809.   "Show message in wais."
  1810.   (interactive "p")
  1811.   (widen)
  1812.   (let (blurb)
  1813.     (let ((beg (point-min))
  1814.       (end (point-max)))
  1815.       (goto-char beg)
  1816.       (forward-line 1)
  1817.       (if (= (following-char) ?0)
  1818.       (progn
  1819.         (rmail-reformat-message beg end)
  1820.         (rmail-set-attribute "unseen" nil))
  1821.       (search-forward "\n*** EOOH ***\n" end t)
  1822.       (narrow-to-region (point) end))
  1823.       (goto-char (point-min))
  1824.                     ;    (rmail-display-labels)
  1825.                     ;    (run-hooks 'rmail-show-message-hook)
  1826.       (if blurb
  1827.       (message blurb)))))
  1828.  
  1829. (defun waisq (&optional name)
  1830.   "Edit a Wais Question"
  1831.   (interactive "sEdit an existing question named: ")
  1832.   (display-question name))
  1833.  
  1834. ;; question Menu mode is suitable only for specially formatted data.
  1835. (put 'question-menu-mode 'mode-class 'special)
  1836.  
  1837. (defun question-menu-mode ()
  1838.   "Major mode for editing a list of questions.
  1839.    Each line describes one of the questions in Emacs.
  1840.    Letters do not insert themselves; instead, they are commands.
  1841.    q (or space) -- select question of line point is on.
  1842.    Precisely,\\{question-menu-mode-map}"
  1843.   (kill-all-local-variables)
  1844.   (use-local-map question-menu-mode-map)
  1845.   (setq truncate-lines *waisq-truncate-mode*)
  1846.   (setq question-read-only t)
  1847.   (setq major-mode 'question-menu-mode)
  1848.   (setq mode-name "Question Menu")
  1849.   (run-hooks 'question-menu-mode-hook))
  1850.  
  1851. (defun question-menu-select ()
  1852.   "Select question described by this line of question menu."
  1853.   (interactive)
  1854.   (let* ((path (question-menu-get-path)))
  1855.     (if (null path)
  1856.     (progn
  1857.       (message "No question selected")
  1858.       (bury-buffer))
  1859.     (progn
  1860.       (set-buffer-modified-p nil)
  1861.       (switch-to-buffer (other-buffer))
  1862.       (bury-buffer question-menu-buffer-name)
  1863.       (message "Fetching Question %s..." path)
  1864.       (display-question path)
  1865.       (message "Fetching Question %s...done." path)))))
  1866.  
  1867. (defun question-menu-get-path ()
  1868.   "returns the pathname on this line"
  1869.   (if (= (current-line) 1)
  1870.       nil
  1871.       (progn
  1872.     (beginning-of-line)
  1873.     (let ((begin (point)))
  1874.       (end-of-line)
  1875.       (let ((answer (buffer-substring begin (point))))
  1876.         (beginning-of-line)
  1877.         (cond ((or (= 0 (length answer))
  1878.                (char-equal (aref "<" 0) (aref answer 0)))
  1879.            (message "No Question on this line")
  1880.            nil)
  1881.           (t answer)))))))
  1882.  
  1883. (defun all-questions ()
  1884.   "returns a list of the names of questions.  This should look into the 
  1885.       question and pull out the name, but that is not in the question struct yet."
  1886.   (let ((answer ())
  1887.     last-char)
  1888.     (let ((directory *wais-question-directory*))
  1889.       (dolist (file (directory-files directory))
  1890.     (setq last-char (aref file (1- (length file))))
  1891.     (if (and (not (file-directory-p (concat directory file)))
  1892.          (not (member file answer))
  1893.          (not (or (string= file ".")
  1894.               (string= file "..")
  1895.               (eq last-char ?~)
  1896.               (eq last-char ?#))))
  1897.         (push file answer))))
  1898.     (nreverse answer)))
  1899.  
  1900. (defun wais-select-question ()
  1901.   "Make a menu of questions so you can select one.  
  1902.    Type ? after invocation to get help on commands available.
  1903.    Type q immediately to make the question menu go away."
  1904.   (interactive)
  1905.   (let ((questions (all-questions)))
  1906.     (if questions
  1907.     (progn
  1908.       (delete-other-windows)
  1909.       (switch-to-buffer "*Question List*")  
  1910.       (question-menu-mode)
  1911.       (setq buffer-read-only nil)
  1912.       (erase-buffer)
  1913.       (insert "<<Select a question with <space> or 'q'>>\n")
  1914.       (dolist (question questions)
  1915.         (insert question)
  1916.         (insert "\n"))
  1917.       (delete-char -1)
  1918.       (goto-char (point-min))
  1919.       (forward-line 1)
  1920.       (setq buffer-read-only t)
  1921.       (message
  1922.         "Commands: <space>, q, ? for help.")
  1923.       nil)
  1924.     (when (yes-or-no-p
  1925.         "You have no questions.  would you like to create one? ")
  1926.       (wais-create-question)))))
  1927.  
  1928. (defvar question-menu-mode-map nil "")
  1929. (defvar question-menu-buffer-name "*Question List*")
  1930.  
  1931. (defun setup-question-mode-map ()
  1932.   (suppress-keymap question-menu-mode-map t)
  1933.   (define-key question-menu-mode-map "q" 'question-menu-select)
  1934.   (define-key question-menu-mode-map "s" 'question-menu-select)
  1935.   (define-key question-menu-mode-map " " 'question-menu-select)
  1936.   (define-key question-menu-mode-map "n" 'next-line)
  1937.   (define-key question-menu-mode-map "p" 'previous-line)
  1938.   (define-key question-menu-mode-map "?" 'describe-mode))
  1939.  
  1940. (if question-menu-mode-map
  1941.     ()
  1942.     (progn
  1943.       (setq question-menu-mode-map (make-keymap))
  1944.       (setup-question-mode-map)))
  1945.  
  1946. (defun wais-novice ()
  1947.   "Create and run the 'Quick' novice question, and pop up
  1948. the novice Help"
  1949.   (interactive)
  1950.   (make-wais-novice-question))
  1951.  
  1952. (defun make-wais-novice-question ()
  1953.   (wais-create-question "Quick" "?" "directory-of-servers.src")
  1954.   (wais-query)
  1955.   (show-novice-wais-help))
  1956.  
  1957. (defvar *wais-novice-string* 
  1958. "First, I've created a 'Quick' question for you, and hopefully it ran.  You
  1959. now see a typical WAIS display.  Let me first tell you that you can scroll
  1960. this window by pressing the space bar and the Delete key, in case you can't
  1961. see it all.
  1962.  
  1963. There are five parts to this display:
  1964. 1. the Search words
  1965. 2. the Sources to search
  1966. 3. some documents that might be similar to your intended document
  1967. 4. the Resulting documents from the search
  1968. 5. a document, in this case, this message.
  1969.  
  1970. You can now use this Question to ask further questions, or you might wish
  1971. to create some questions of your own (they don't all have to be the 'Quick'
  1972. question).
  1973.  
  1974. The most useful keystrokes for using WAISQ mode are (case is important!):
  1975.  
  1976. <space>:  scroll the text in the other window up
  1977.   <del>:  scroll the text in the other window down
  1978.       k:  switches you to the search word window
  1979.   e,f,v:  view the current result document in a window like this one.
  1980.       a:  add the current document to the relevant documents list
  1981.       d:  delete all the relevant documents
  1982.       A:  capital A adds a new source
  1983.       D:  captial D deletes all the sources.
  1984.   g,RET:  perform the query.
  1985.     C-l:  rebuild the display, removing the document view window.
  1986.       s:  select a new Question
  1987.       q:  quit out of this question, and bury it.
  1988.       Q:  capital Q quits out of this question, and kill all its buffers.
  1989.       ?:  describe waisq-mode shows all new keystrokes associated with
  1990.           WAISQ mode.
  1991.  
  1992. You really shouldn't have to use C-x o to switch to other windows, but if
  1993. you do, you should go back to the result-documents window and press C-l to
  1994. rebuild the display.")
  1995.  
  1996. (defun show-novice-wais-help ()
  1997.   "Show something useful for a new user of WAIS"
  1998.   (interactive)
  1999.   (wais-redisplay-internal)
  2000.   (when wais-split
  2001.     (setq wais-split nil)
  2002.     (split-window (get-buffer-window (current-buffer))*wais-document-display-size*))
  2003.   (other-window 1)
  2004.   (switch-to-buffer (get-buffer-create "*WAIS Novice Help*"))
  2005.   (erase-buffer)
  2006.   (insert *wais-novice-string*)
  2007.   (goto-char (point-min))
  2008.   (other-window -1))
  2009.  
  2010. (defun wais-create-question (&optional name keywords source)
  2011.   "Create a new Question named NAME"
  2012.   (interactive)
  2013.   (let ((new (check-init-directories)))
  2014.     (unless name
  2015.       (setq name (read-input "Create a new question named: ")))
  2016.     (unless keywords
  2017.       (setq keywords ""))
  2018.     (unless source
  2019.       (setq source (get-source-name)))
  2020.     (let ((file (expand-file-name
  2021.           (concat *wais-question-directory*
  2022.               name))))
  2023.       (create-question-internal file keywords source)
  2024.       (display-question name)
  2025.       (wais-goto-keywords))
  2026.     (if new
  2027.     (message "For more information, try M-x wais-novice"))))
  2028.  
  2029. (defun create-question-internal (file keywords source)
  2030.   (find-file file)
  2031.   (erase-buffer)
  2032.   (insert  "(:question 
  2033.        :version  2 
  2034.        :seed-words \"" keywords "\"
  2035.        :sources 
  2036.        (  (:source-id 
  2037.        :filename \"" source "\"
  2038.        ) 
  2039.      )
  2040.        )
  2041. ")
  2042.   (let ((require-final-newline nil))
  2043.     (save-buffer 0))
  2044.   (kill-buffer (current-buffer)))
  2045.  
  2046. (defun find-documents-on ()
  2047.   "Obsolete.  Use M-x wais or M-x wais-create-question"
  2048.   (interactive)
  2049.   (message "Obsolete.  Use M-x wais or M-x wais-create-question"))
  2050.  
  2051. (defun delete-string ()
  2052.   (search-forward "\"")
  2053.   (let ((here (1- (point))))
  2054.     (search-forward "\"")
  2055.     (delete-char (- here (point)))))
  2056.  
  2057. (defun wais-goto-keywords ()
  2058.   "Go to the keyword window for this question"
  2059.   (interactive)
  2060.   (wais-redisplay-internal)
  2061.   (other-window -3))
  2062.  
  2063. (defun wais-replace-keywords (&optional keys)
  2064.   "Replace the 'Find documents on' words in the current Question"
  2065.   (interactive "sFind documents on: ")
  2066.   (if (> (length keys) 4999)
  2067.       (error "Keys longer than 5000 characters.  I Can't handle that.")
  2068.       (let ((file current-question-filename)
  2069.         (name question-name))
  2070.     (find-file file)
  2071.     (goto-char (point-min))
  2072.     (search-forward ":seed-words")
  2073.     (delete-string)
  2074.     (insert " \"" keys "\"")
  2075.     (let ((require-final-newline nil))
  2076.       (save-buffer 0))
  2077.     (kill-buffer (current-buffer)))))
  2078.  
  2079. (defun wais-delete-sources ()
  2080.   "Delete all sources from this question"
  2081.   (interactive)
  2082.   (let ((doc (current-line))
  2083.     (file current-question-filename)
  2084.     (name question-name))
  2085.     (update-keywords name)
  2086.     (find-file file)
  2087.     (emacs-lisp-mode)
  2088.     (goto-char (point-min))
  2089.     (search-forward ":sources")
  2090.     (search-forward "(")
  2091.     (backward-char 1)
  2092.     (let ((loc (point)))
  2093.       (forward-sexp 1)
  2094.       (setq loc (point))
  2095.       (forward-sexp -1)
  2096.       (delete-char (- loc (point)))
  2097.       (insert "(  )")
  2098.       (let ((require-final-newline nil))
  2099.     (save-buffer 0))
  2100.       (kill-buffer (current-buffer))
  2101.       (display-question name current-question-filename)
  2102.       (forward-line (1- doc)))))
  2103.  
  2104.  
  2105. (defun wais-add-source (&optional source)
  2106.   "Add a Source to the current Question"
  2107.   (interactive)
  2108.   (unless source
  2109.     (setq source (get-source-name)))
  2110.   (let ((doc (current-line))
  2111.     (file current-question-filename)
  2112.     (name question-name))
  2113.     (update-keywords name)
  2114.     (find-file file)
  2115.     (goto-char (point-min))
  2116.     (search-forward ":sources")
  2117.     (search-forward "(")
  2118.     (insert "  (:source-id :filename \"" source "\" ) 
  2119. ")
  2120.     (let ((require-final-newline nil))
  2121.       (save-buffer 0))
  2122.     (kill-buffer (current-buffer))
  2123.     (display-question name current-question-filename)
  2124.     (forward-line (1- doc))))
  2125.  
  2126.  
  2127.  
  2128. (defvar *wais-selected-sources* nil
  2129.   "A list of selected sources for a default question")
  2130.  
  2131. ;; source Menu mode is suitable only for specially formatted data.
  2132. (put 'source-menu-mode 'mode-class 'special)
  2133.  
  2134. (defun source-menu-mode ()
  2135.   "Major mode for editing a list of sources.
  2136. Each line describes one of the sources in Emacs.
  2137. Letters do not insert themselves; instead, there are commands.
  2138. q, s, v, or space -- view the source of line point is on.
  2139. Precisely,\\{source-menu-mode-map}"
  2140.   (kill-all-local-variables)
  2141.   (use-local-map source-menu-mode-map)
  2142.   (setq truncate-lines *waisq-truncate-mode*)
  2143.   (setq source-read-only t)
  2144.   (setq major-mode 'source-menu-mode)
  2145.   (setq mode-name "Source Menu")
  2146.   (run-hooks 'source-menu-mode-hook))
  2147.  
  2148. (defun source-menu-view ()
  2149.   "View source described by this line of source menu."
  2150.   (interactive)
  2151.   (let* ((path (source-menu-get-path)))
  2152.     (if (null path)
  2153.     (message "No source selected")
  2154.     (if (file-exists-p (concat *wais-source-directory* path))
  2155.         (view-file (concat *wais-source-directory* path))
  2156.         (if (file-exists-p (concat *common-source-directory* path))
  2157.         (view-file (concat *common-source-directory* path))))))
  2158.   (bury-buffer)
  2159.   (if (eq major-mode 'waisq-mode)
  2160.       (wais-redisplay-internal)))
  2161.  
  2162. (defun source-menu-get-path ()
  2163.   "returns the pathname on this line"
  2164.   (if (= (current-line) 1)
  2165.       nil
  2166.       (progn
  2167.     (beginning-of-line)
  2168.     (let ((begin (point)))
  2169.       (end-of-line)
  2170.       (let ((answer (buffer-substring begin (point))))
  2171.         (beginning-of-line)
  2172.         (cond ((or (= 0 (length answer))
  2173.                (char-equal (aref "<" 0) (aref answer 0)))
  2174.            (message "No Source on this line")
  2175.            nil)
  2176.           (t answer)))))))
  2177.  
  2178. (defun all-sources ()
  2179.   "returns a list of the names of sources.  This should look into the 
  2180.    source and pull out the name, but that is not in the source struct yet."
  2181.   (let ((answer ())
  2182.     last-char)
  2183.     (if (and (stringp *wais-source-directory*)
  2184.          (file-directory-p *wais-source-directory*))
  2185.     (dolist (file (directory-files *wais-source-directory*))
  2186.       (setq last-char (aref file (1- (length file))))
  2187.       (if (and (> (length file) 3)
  2188.            (string= (substring file -4) ".src"))
  2189.           (push (cons file file) answer))))
  2190.     (if (and *common-source-directory*
  2191.          (stringp *common-source-directory*)
  2192.          (not (eq *common-source-directory* *wais-source-directory*))
  2193.          (file-exists-p *common-source-directory*))
  2194.     (dolist (file (directory-files *common-source-directory*))
  2195.       (if (and (> (length file) 3)
  2196.            (string= (substring file -4) ".src"))
  2197.           (push (cons file file) answer))))
  2198.     (unless (null answer)
  2199.       (sort answer '(lambda (a b) (string< (car a) (car b)))))))
  2200.  
  2201. (defun wais-view-source ()
  2202.   "Make a menu of sources so you can select one to view.  
  2203. Type ? after invocation to get help on commands available.
  2204. Type q immediately to make the source menu go away."
  2205.   (interactive)
  2206.   (let ((sources (all-sources)))
  2207.     (if sources
  2208.     (progn
  2209.       (delete-other-windows)
  2210.       (switch-to-buffer "*Source List*")  
  2211.       (source-menu-mode)
  2212.       (setq buffer-read-only nil)
  2213.       (erase-buffer)
  2214.       (insert "<<Select a source with <space> or 'q', view with 'v'>>\n")
  2215.       (dolist (source sources)
  2216.         (insert (car source))
  2217.         (insert "\n"))
  2218.       (delete-char -1)
  2219.       (goto-char (point-min))
  2220.       (forward-line 1)
  2221.       (setq buffer-read-only t)
  2222.       (message
  2223.         "Commands: <space>, q, v or ? for help.")
  2224.       nil)
  2225.     (message "No sources.  Something is wrong - see your site administrator"))))
  2226.  
  2227. (defvar source-menu-mode-map nil "")
  2228. (defvar source-menu-buffer-name "*Source List*")
  2229.  
  2230. (defun setup-source-mode-map ()
  2231.   (suppress-keymap source-menu-mode-map t)
  2232.   (define-key source-menu-mode-map "q" 'source-menu-view)
  2233.   (define-key source-menu-mode-map "s" 'source-menu-view)
  2234.   (define-key source-menu-mode-map " " 'source-menu-view)
  2235.   (define-key source-menu-mode-map "n" 'next-line)
  2236.   (define-key source-menu-mode-map "p" 'previous-line)
  2237.   (define-key source-menu-mode-map "v" 'source-menu-view)
  2238.   (define-key source-menu-mode-map "?" 'describe-mode))
  2239.  
  2240. (if source-menu-mode-map
  2241.     ()
  2242.     (progn
  2243.       (setq source-menu-mode-map (make-keymap))
  2244.       (setup-source-mode-map)))
  2245.  
  2246. (defun get-source-name ()
  2247.   (let ((result "")
  2248.     (sources (all-sources)))
  2249.     (save-window-excursion
  2250.       (delete-other-windows)
  2251.       (if sources
  2252.       (progn
  2253.         (while (string= result "")
  2254.           (setq result
  2255.             (completing-read "Select Source (press ? for a list of sources): "
  2256.                      sources nil t nil)))
  2257.         result)
  2258.       (message
  2259.         "No sources.  Something is wrong - see your site administrator")))))
  2260.  
  2261. (defun source-defined-p (source)
  2262.   (assoc source (all-sources)))
  2263.  
  2264. (defvar index-types '(("groliers" . "groliers")
  2265.               ("mail" . "mail")
  2266.               ("rmail" . "rmail")
  2267.               ("netnews" . "netnews")
  2268.               ("catalog" . "catalog")
  2269.               ("bio" . "bio")
  2270.               ("cmapp" . "cmapp")
  2271.               ("text" . "text")
  2272.               ("para". "para")))
  2273.  
  2274. (defun basename (path)
  2275.   (do ((loc (1- (length path)) (1- loc)))
  2276.       ((or (minusp loc)
  2277.        (eq (aref path loc) ?/))
  2278.        (substring path (1+ loc)))))
  2279.  
  2280. ;;; this will create and index a database
  2281. ;;; but uses local search (no configuration).
  2282.  
  2283. (require 'compile)
  2284.  
  2285. (defun wais-index (command)
  2286.   "Run waisindex-program, with user-specified args, and collect output in a buffer."
  2287.   (interactive "sIndex (with args): ")
  2288.   (compile1 (concat waisindex-program command)
  2289.         "Done" "waisindex"))
  2290.  
  2291. (defun wais-create-source (source)
  2292.   "Create a new Source and a database to go with it"
  2293.   (interactive "sName for this Source: ")
  2294.   (let ((server-name-or-address nil)
  2295.     (port nil))
  2296.     (if (yes-or-no-p "Shall I create the index? ")
  2297.     (let* ((db (read-file-name "File(s) to index (unix wildcards allowed): "))
  2298.            (type (completing-read "Type (press ? for a list of types, default is Text): "
  2299.                       index-types nil t nil))
  2300.            (exportp (yes-or-no-p "Export this Source? "))
  2301.            (index (concat (if exportp
  2302.                   *common-source-directory*
  2303.                   *wais-source-directory*)
  2304.                   source)))
  2305.       (if (string= type "") (setq type "text"))
  2306.       (wais-index (concat (case wais-version
  2307.                 (7 " -i ")
  2308.                 (8 " -d ")
  2309.                 (t " -d "))
  2310.                   index " -t " type " "
  2311.                   (case wais-version
  2312.                 (7 "")
  2313.                 (8 (if exportp
  2314.                        " -export "
  2315.                        ""))
  2316.                 (t ""))
  2317.                   (expand-file-name db))))
  2318.     (progn
  2319.       (setq index (read-file-name "Index for this sources (path prefix, without . suffix): "))
  2320.       (setq server-name-or-address (read-input "On Server: "))
  2321.       (if (not (string= server-name-or-address ""))
  2322.           (setq port (read-input "Using port: ")))
  2323.       (message "Creating source %s, for index %s..." source index)
  2324.       (find-file (concat *wais-source-directory*
  2325.                  (if (string= (substring *wais-source-directory* -1) "/")
  2326.                  ""
  2327.                  "/")
  2328.                  source ".src"))
  2329.       (erase-buffer)
  2330.       (insert "(:source
  2331.    :version  3
  2332.    " (if (and server-name-or-address
  2333.           (not (string= server-name-or-address "")))
  2334.      (concat ":ip-name \"" server-name-or-address "\"
  2335.    ")
  2336.      "")
  2337.    (if (and port
  2338.         (not (string= "" port)))
  2339.        (concat ":tcp-port " port "
  2340.    ")
  2341.        "")
  2342.    ":database-name \"" (expand-file-name index) "\"
  2343.    :cost 0.00
  2344.    :cost-unit :free
  2345.    :description \"Source structure created by GMACS Wais interface, ")
  2346.       (insert-date t)
  2347.       (insert "\"
  2348.    )")
  2349.       (let ((require-final-newline nil))
  2350.         (save-buffer 0))
  2351.       (kill-buffer (current-buffer))
  2352.       (message "Creating source %s, for index %s...done." source index)
  2353.       ))))
  2354.  
  2355.  
  2356. ;;; a simple way to get into "wais"
  2357.  
  2358. (defun wais ()
  2359.   "Find a wais question and go to it.
  2360. First tries to find the question named Quick, then any wais question,
  2361. finally it creates a Quick question, prompting for search words and source.
  2362. If this is the first time a user tries to use wais, it will create a new
  2363. question name Quick, using the directory-of-servers as a source, and submit
  2364. a '?' for the query."
  2365.   (interactive)
  2366.   (let ((quick-buffer (get-buffer "Quick: Results")))
  2367.     (if quick-buffer
  2368.     (progn
  2369.       (set-buffer quick-buffer)
  2370.       (wais-redisplay-internal))
  2371.      ;;; that means we don't have a quick question around.
  2372.      ;;; let's find what we've got
  2373.     (do* ((buffers (buffer-list) (cdr buffers))
  2374.           (buffer (car buffers) (car buffers))
  2375.           (done nil))
  2376.          ((or (null buffers) done) 
  2377.           (unless done (wais-create-question "Quick")))
  2378.       (set-buffer buffer)
  2379.       (when (and (boundp 'current-question-filename)
  2380.              current-question-filename)
  2381.         (wais-redisplay-internal)
  2382.         (setq done t))))))
  2383.  
  2384. ;;; code to create the question directory if it doesn't exist
  2385.  
  2386. (defun wais-create-directory (directory)
  2387.   "create a directory"
  2388.   (if (string= "/" (substring directory -1))
  2389.       (setq directory (substring directory 0 -1)))
  2390.   (shell-command-fast (concat "/bin/mkdir " directory))
  2391.   (if (null (file-attributes directory))
  2392.       (error "Could not create directory %s" directory)))
  2393.  
  2394. (defun check-init-directories ()
  2395.   (let ((result nil))
  2396.     (if (not (file-attributes *wais-question-directory*))
  2397.     (progn (message "Creating %s" *wais-question-directory*)
  2398.            (wais-create-directory (expand-file-name *wais-question-directory*))
  2399.            (setq result t)))
  2400.     (if (not (file-attributes *wais-source-directory*))
  2401.     (progn (message "Creating %s" *wais-source-directory*)
  2402.            (wais-create-directory (expand-file-name *wais-source-directory*))
  2403.            (setq result t)))
  2404.     (if (not (file-attributes *wais-document-directory*))
  2405.     (progn (message "Creating %s" *wais-document-directory*)
  2406.            (wais-create-directory (expand-file-name *wais-document-directory*))
  2407.            (setq result t)))
  2408.     result))
  2409.